home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / wndw70.zip / WNDWDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-10  |  11KB  |  337 lines
  1. { ========================================================================== }
  2. { WndwDemo.pas - Multi-level window demo for WNDW70A.TPU  ver 7.0a, 06-10-93 }
  3. {                                                                            }
  4. { This demo shows just a few features multi-level windows, including high    }
  5. { speed screen design.                                                       }
  6. {   Copyright (C) 1993 by James H. LeMay,  All rights reserved.              }
  7. { ========================================================================== }
  8.  
  9. program WindowDemo;
  10.  
  11. {$M 16384, 10000, 10000 }
  12. {$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  13.  
  14. uses Crt,Qwik,Wndw,Goof,Strs;
  15.  
  16. type
  17.   Str40 = string[40];
  18.   Steps = (Step0,Step1,Step2,Step3,Step4,Step5);
  19.  
  20. var
  21.   Step:              Steps;
  22.   i,j:               word;
  23.   Key:               char;
  24.  
  25. const
  26.   FuncKey = #00;
  27.   RetKey = #13;
  28.   EscKey = #27;
  29.   StrA : array [1..16] of Str40 = (
  30.     'WNDW70A.TPU works these ...',
  31.     '',
  32.     'COMPUTERS:           ADAPTERS:',
  33.     '──────────────────   ─────────',
  34.     'IBM PC               MDA',
  35.     'IBM XT               CGA',
  36.     'IBM AT               EGA',
  37.     'IBM PCjr             MCGA',
  38.     'IBM PC Convertible   VGA',
  39.     'IBM PS/2 Model 25    8514/A',
  40.     'IBM PS/2 Model 30    Hercules:',
  41.     'IBM PS/2 Model 50     HGC',
  42.     'IBM PS/2 Model 60     HGC Plus',
  43.     'IBM PS/2 Model 70     InColor',
  44.     'IBM PS/2 Model 80 ',
  45.     'IBM 3270 PC');
  46.  
  47.   StrB : array [1..10] of Str40 = (
  48.     'If you have any questions or comments,',
  49.     'please write to or call:',
  50.     '',
  51.     '     Eagle Performance Software',
  52.     '     TP/TC Products',
  53.     '     Attn: Jim LeMay',
  54.     '           (CIS 76011,217)',
  55.     '     6341 Klamath Road',
  56.     '     Ft. Worth, TX  76116-1617',
  57.     '     1-(817)-735-4833');
  58.  
  59. procedure DisplayBaseScreen;
  60. begin
  61.   { -- Create initial screen -- }
  62.   WWriteC ( 2,'Multi-Level Virtual Windows');
  63.   WWriteC ( 3,'Version 7.0a for');
  64.   WWriteC ( 4,'Borland Pascal 7.0');
  65.   TWS.WndwAttr := LightGrayBG;
  66.   WWriteC ( 6,'For each of the following displays:');
  67.   WWriteC ( 8,'1. Press RETURN to continue.');
  68.   WWriteC ( 9,'2. Press ESC to back up.    ');
  69.   TWS.WSline := SingleBrdr;
  70.   WLineH  (12, 1,CRTcols);
  71.   WWriteC (16,'This is the base screen without windows.  Let''s just see ');
  72.   WWriteC (17,'how fast WNDW can create complex screen designs.  As soon');
  73.   WWriteC (18,'as you press return, WNDW will start creating a screen   ');
  74.   WWriteC (19,'from scratch.  Nothing has been done yet.  Then WNDW will');
  75.   WWRiteC (20,'display the resulting window on the screen.  Try to time ');
  76.   WWRiteC (21,'it, but don''t blink!                                     ');
  77.   Step:=Step0;
  78. end;
  79.  
  80. procedure DisplayScreenDesign;
  81. {}procedure DoAssets;
  82.   begin
  83.     SetWindowModes (SeeThruMode+RelMode);
  84.     MakeWindow ( 3, 1,12,39,GreenBG,SameAttr,NoBrdr,aWindow);
  85.     with TWS do
  86.       begin
  87.         WndwAttr := LightGrayBG;
  88.         WClrLine (1);
  89.         WWriteC ( 1,    'A S S E T S');
  90.         WEosToRC ( 3,33);
  91.         QfillEos (12, 7,LightGrayBG,' ');
  92.         WndwAttr := OrigAttr;
  93.         WWrite  ( 2, 2, 'Current Assets:');
  94.         WWrite  ( 3, 3,  'Cash and Equivalents');
  95.         WWrite  ( 4, 3,  'Accounts Receivable:');
  96.         WClrEos (WndwAttr);
  97.         WWrite  ( 5, 4,   'United States');
  98.         WWrite  ( 6, 4,   'Canada');
  99.         WWrite  ( 7, 4,   'Europe');
  100.         WWrite  ( 8, 3,  'Contracts in process');
  101.         WWrite  ( 9, 3,  'Inventories');
  102.         WWrite  (10, 3,  'Prepaid expenses');
  103.         WWrite  (11, 2, 'Total Current Assets');
  104.         WWrite  (12, 2, 'Property and Equipment');
  105.         WWrite  (14, 2, 'Total Assets:');
  106.       end;
  107. {}end;
  108. {}procedure DoAssetNums;
  109.   const
  110.     Cash:         integer =   128;
  111.     US:           integer =  1757;
  112.     Canada:       integer =  1827;
  113.     Europe:       integer =  1426;
  114.     Contracts:    integer = 10802;
  115.     Inventory:    integer =  4872;
  116.     Prepaid:      integer =   443;
  117.     Property:     integer =  1140;
  118.   var
  119.     TotalCA,TotalAssets: longint;
  120.   begin
  121.     MakeWindow ( 3,33,12, 7,LightGrayBG,SameAttr,NoBrdr,aWindow);
  122.     TotalCA := Cash+US+Canada+Europe+Contracts+Inventory;
  123.     TotalAssets := TotalCA+PrePaid;
  124.     WWriteC ( 3,StrLF(Cash       ,5));
  125.     WWriteC ( 5,StrLF(US         ,5));
  126.     WWriteC ( 6,StrLF(Canada     ,5));
  127.     WWriteC ( 7,StrLF(Europe     ,5));
  128.     WWriteC ( 8,StrLF(Contracts  ,5));
  129.     WWriteC ( 9,StrLF(Inventory  ,5));
  130.     WWriteC (10,StrLF(Prepaid    ,5));
  131.     WWriteC (11,StrLF(TotalCA    ,5));
  132.     WWriteC (12,StrLF(Property   ,5));
  133.     WWriteC (14,StrLF(TotalAssets,5));
  134. {}end;
  135. {}procedure DoLiabilities;
  136.   begin
  137.   MakeWindow ( 3,41,12,38,GreenBG,SameAttr,NoBrdr,aWindow);
  138.   with TWS do
  139.     begin
  140.       WEosToRC ( 3,32);
  141.       QfillEos (12, 7,LightGrayBG,' ');
  142.       WndwAttr := White+BlueBG;
  143.       WClrLine (1);
  144.       WWriteC ( 1,    'L I A B I L I T I E S');
  145.       WndwAttr := OrigAttr;
  146.       WWrite  ( 2, 2, 'Current Liabilities:');
  147.       WClrEos (WndwAttr);
  148.       WWrite  ( 3, 3,  'Commercial paper');
  149.       WWrite  ( 4, 3,  'Accounts payable');
  150.       WWrite  ( 5, 3,  'Accrued salariess');
  151.       WWrite  ( 6, 3,  'Deferred taxes');
  152.       WWrite  ( 7, 2, 'Total Current');
  153.       WWrite  ( 8, 2, 'Noncurrent Liabilities:');
  154.       WClrEos (WndwAttr);
  155.       WWrite  ( 9, 3,  'Long-term debt');
  156.       WWrite  (10, 3,  'Product liability');
  157.       WWrite  (11, 3,  'Deferred taxes');
  158.       WWrite  (12, 2, 'Total Noncurrent');
  159.       WWrite  (14, 2, 'Total Liabilities:');
  160.     end;
  161. {}end;
  162. {}procedure DoLiabNums;
  163.   const
  164.     Paper:        integer =  3331;
  165.     Payable:      integer =  5776;
  166.     Salaries:     integer =  6430;
  167.     Taxes1:       integer =  2344;
  168.     LongTerm:     integer =   402;
  169.     Product:      integer =  1876;
  170.     Taxes2:       integer =  1096;
  171.   var
  172.     TotalCL,TotalNL,TotalLiabs: longint;
  173.   begin
  174.     MakeWindow ( 3,72,12, 7,LightGrayBG,SameAttr,NoBrdr,aWindow);
  175.     TotalCL := Paper+Payable+Salaries+Taxes1;
  176.     TotalNL := LongTerm+Product+Taxes2;
  177.     TotalLiabs := TotalCL+TotalNL;
  178.     WWriteC ( 3,StrLF(Paper      ,5));
  179.     WWriteC ( 4,StrLF(Payable    ,5));
  180.     WWriteC ( 5,StrLF(Salaries   ,5));
  181.     WWriteC ( 6,StrLF(Taxes1     ,5));
  182.     WWriteC ( 7,StrLF(TotalCL    ,5));
  183.     WWriteC ( 9,StrLF(LongTerm   ,5));
  184.     WWriteC (10,StrLF(Product    ,5));
  185.     WWriteC (11,StrLF(Taxes2     ,5));
  186.     WWriteC (12,StrLF(TotalNL    ,5));
  187.     WWriteC (14,StrLF(TotalLiabs ,5));
  188. {}end;
  189. {}procedure DoAuditor;
  190.   begin
  191.     MakeWindow (18, 1, 6,78,GreenBG,SameAttr,NoBrdr,aWindow);
  192.     with TWS do
  193.       begin
  194.         WWrite   ( 1, 2,'Auditor:');
  195.         WWrite   ( 2, 2,'Business Address:');
  196.         WWrite   ( 3, 2,'Mailing Address:');
  197.         WWrite   ( 4, 2,'Contact:');
  198.         WWrite   ( 5, 2,'Comments:');
  199.         SetWindowModes (RelMode);
  200.         MakeWindow (18,19, 6,60,Black+LightGrayBG,SameAttr,NoBrdr,aWindow);
  201.         WWrite   ( 1, 1,'Ferret Auditors of Texas, Inc.');
  202.         WWrite   ( 2, 1,'1234 Technical Avenue      ');
  203.         QwriteEos (GreenBG,' State: ');
  204.         QwriteEos (SameAttr,'Texas    ');
  205.         QwriteEos (GreenBG,' Zip: ');
  206.         QwriteEos (SameAttr,'76125-1200');
  207.         WWrite   ( 3, 1,'P.O. Box 122237            ');
  208.         QwriteEos (GreenBG,' State: ');
  209.         QwriteEos (SameAttr,'Texas    ');
  210.         QwriteEos (GreenBG,' Zip: ');
  211.         QwriteEos (SameAttr,'76125-1281');
  212.         WWrite   ( 4, 1,'John Q. Public, CPA        ');
  213.         QwriteEos (GreenBG,' Phone: ');
  214.         QwriteEos (SameAttr,'(817)-555-1212');
  215.         WWrite   ( 5, 1,'Was this screen fast enough for you?');
  216.         WWrite   ( 6, 1,'Press RETURN to continue or ESC to back up.');
  217.       end;
  218. {}end;
  219. {}procedure DoPartitions;
  220.   begin
  221.     RemoveWindow;   { Back to parent window. }
  222.     with TWS do
  223.       begin
  224.         WWriteC ( 1,'1994 CONSOLIDATED BALANCE (Dollars in thousands)');
  225.         WSline := SingleBrdr;
  226.         WLineH    ( 2, 1,Wcols);
  227.         WLineH    (15, 1,Wcols);
  228.         WLineV    ( 3,40,14);
  229.         WLinePart ( 2,40,BrdrTT);
  230.         WLinePart (15,40,BrdrCL);
  231.         WBrdrH (17);
  232.       end;
  233. {}end;
  234. begin
  235.   { -- You can compare how much slower it would be if we didn't use -- }
  236.   { -- HiddenMode.  Try without it and comment out WriteToHidden.   -- }
  237.   SetWindowModes (HiddenMode+CursorOffMode);
  238.   MakeWindow ( 1, 1,25,80,black+GreenBG,White+GreenBG,HdoubleBrdr,Window1);
  239.   WriteToHidden (Window1);
  240.   TitleWindow (Top,Left,Yellow+GreenBG,' High Speed Screen Design ');
  241.   DoAssets;
  242.   DoAssetNums;
  243.   DoLiabilities;
  244.   DoLiabNums;
  245.   DoAuditor;
  246.   DoPartitions;
  247.   ShowWindow (Window1);
  248. end;
  249.  
  250. procedure DisplayEquipmentList;
  251. begin
  252.   { -- Compatible computers and adapters for WNDW70.TPU -- }
  253.   SetWindowModes (ZoomMode);
  254.   MakeWindow ( 4,35,18,34,White+BlueBG,LightCyan+blueBG,HdoubleBrdr,aWindow);
  255.   TitleWindow (Top,Center,SameAttr,' Software Compatibility ');
  256.   for j:=1 to 16 do
  257.     WWrite (j, 2,StrA[j]);
  258. end;
  259.  
  260. procedure DisplayAuthor;
  261. begin
  262.   { -- Author for WNDW70.TPU -- }
  263.   SetWindowModes (ZoomMode);
  264.   if VideoMode<>7 then
  265.     SetWindowModes (WindowModes+ShadowRight+ShadowTrans);
  266.   Brdr[UserBrdr2].BrdrArray:='┌┴┐┤├└┬┘┼─┼┼│┼┼';
  267.   MakeWindow ( 6,20,13,42,Blue+CyanBG,Blue+CyanBG,UserBrdr2,aWindow);
  268.   for j:=1 to 10 do
  269.     WWrite (j,2,StrB[j]);
  270.   TitleWindow (Bottom,Center,SameAttr,' Press RETURN to exit ');
  271. end;
  272.  
  273. procedure GetKey;
  274. var
  275.   ExtKey: boolean;
  276. begin
  277.   repeat
  278.     Key:=ReadKey;                        { Read keyboard input.      }
  279.     if KeyPressed and (Key=FuncKey) then { If first Char was #00 ... }
  280.       begin
  281.         Key:=ReadKey;                    { ... read second char.     }
  282.         ExtKey := true
  283.       end
  284.     else ExtKey:=false;
  285.   until (Key=RetKey) or (Key=EscKey);
  286. end;
  287.  
  288. procedure FindNextStep;
  289. begin
  290.   case Key of
  291.   EscKey: if Step>Step0 then
  292.            begin
  293.              RemoveWindow;
  294.              dec (Step);
  295.            end;
  296.   RetKey: inc (Step);
  297.   end  { case }
  298. end;
  299.  
  300. procedure DisplayWindows;
  301. begin
  302.   repeat
  303.     GetKey;
  304.     FindNextStep;
  305.     if Key=RetKey then
  306.       case Step of
  307.         Step1:  DisplayScreenDesign;
  308.         Step2:  DisplayEquipmentList;
  309.         Step3:  DisplayAuthor;
  310.       end;
  311.    until Step=Step4;
  312. end;
  313.  
  314. procedure SignOff;
  315. begin
  316.   { -- Use the following statment to return to the original screen.-- }
  317.   for i:=1 to LI do RemoveWindow;
  318.   TWS.WndwAttr := LightGray;
  319.   WClrScr;
  320.   SetWindowModes (0);
  321.   MakeWindow (0,0,6,40,White+BlueBG,LightGray+BlueBG,DoubleBrdr,Window0);
  322.   WWriteC ( 2,'Copyright (c) 1993 James H. LeMay');
  323.   WWriteC ( 3,'Eagle Performance Software');
  324.   SetCursor (CursorInitial);
  325.   GotoRC (CRTrows-1,1);
  326. end;
  327.  
  328. begin
  329.   { Qsnow := true; }
  330.   ModCursor (CursorOff);
  331.   PreferMultiTask := true;
  332.   InitWindow (blue+LightGrayBG,true);
  333.   DisplayBaseScreen;
  334.   DisplayWindows;
  335.   SignOff;
  336. end.
  337.